home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / swapij.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  12KB  |  426 lines
  1. /* swapij.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal value[200000];
  26. } blank_;
  27.  
  28. #define blank_1 blank_
  29.  
  30. /*<       subroutine swapij(i1,i2,j1,j2) >*/
  31. /* Subroutine */ int swapij_(i1, i2, j1, j2)
  32. integer *i1, *i2, *j1, *j2;
  33. {
  34.     /* System generated locals */
  35.     integer i_1;
  36.  
  37.     /* Local variables */
  38.     static integer lsav1, lsav2, i, j, ktype;
  39. #define nodplc ((integer *)&blank_1)
  40. #define cvalue ((complex *)&blank_1)
  41.     static integer loc, loc1, loc2;
  42.  
  43. /*<       implicit double precision (a-h,o-z) >*/
  44. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  45. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  46. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  47. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  48. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  49. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  50. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  51. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  52. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  53. /* spice version 2g.6  sccsid=blank 3/15/83 */
  54. /*<       common /blank/ value(200000) >*/
  55. /*<       integer nodplc(64) >*/
  56. /*<       complex cvalue(32) >*/
  57. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  58.  
  59. /*     swap rows i1 and i2 */
  60.  
  61. /*<       loc1=nodplc(jcpt+i1) >*/
  62.     loc1 = nodplc[tabinf_1.jcpt + *i1 - 1];
  63. /*<       loc2=nodplc(jcpt+i2) >*/
  64.     loc2 = nodplc[tabinf_1.jcpt + *i2 - 1];
  65. /*<       nodplc(jcpt+i1)=loc2 >*/
  66.     nodplc[tabinf_1.jcpt + *i1 - 1] = loc2;
  67. /*<       nodplc(jcpt+i2)=loc1 >*/
  68.     nodplc[tabinf_1.jcpt + *i2 - 1] = loc1;
  69.  
  70. /*     check if end of row */
  71.  
  72. /*<     5 if (loc1.le.0.and.loc2.le.0) go to 80 >*/
  73. L5:
  74.     if (loc1 <= 0 && loc2 <= 0) {
  75.     goto L80;
  76.     }
  77.  
  78. /*     check swap type */
  79.  
  80. /*<       if (loc1.eq.0) go to 20 >*/
  81.     if (loc1 == 0) {
  82.     goto L20;
  83.     }
  84. /*<       if (loc2.eq.0) go to 10 >*/
  85.     if (loc2 == 0) {
  86.     goto L10;
  87.     }
  88. /*<       if (nodplc(jcolno+loc1)-nodplc(jcolno+loc2)) 10,15,20 >*/
  89.     if ((i_1 = nodplc[tabinf_1.jcolno + loc1 - 1] - nodplc[tabinf_1.jcolno + 
  90.         loc2 - 1]) < 0) {
  91.     goto L10;
  92.     } else if (i_1 == 0) {
  93.     goto L15;
  94.     } else {
  95.     goto L20;
  96.     }
  97. /*<    10 ktype=-1 >*/
  98. L10:
  99.     ktype = -1;
  100. /*<       j=nodplc(jcolno+loc1) >*/
  101.     j = nodplc[tabinf_1.jcolno + loc1 - 1];
  102. /*<       go to 25 >*/
  103.     goto L25;
  104. /*<    15 ktype=0 >*/
  105. L15:
  106.     ktype = 0;
  107. /*<       j=nodplc(jcolno+loc1) >*/
  108.     j = nodplc[tabinf_1.jcolno + loc1 - 1];
  109. /*<       go to 25 >*/
  110.     goto L25;
  111. /*<    20 ktype=1 >*/
  112. L20:
  113.     ktype = 1;
  114. /*<       j=nodplc(jcolno+loc2) >*/
  115.     j = nodplc[tabinf_1.jcolno + loc2 - 1];
  116.  
  117. /*     find pointer to entry (i1,j) */
  118.  
  119. /*<    25 loc=j >*/
  120. L25:
  121.     loc = j;
  122. /*<    30 lsav1=loc >*/
  123. L30:
  124.     lsav1 = loc;
  125. /*<       loc=nodplc(irpt+loc) >*/
  126.     loc = nodplc[tabinf_1.irpt + loc - 1];
  127. /*<       if (loc.eq.0) go to 40 >*/
  128.     if (loc == 0) {
  129.     goto L40;
  130.     }
  131. /*<       if ((nodplc(irowno+loc)-i1).lt.0) go to 30 >*/
  132.     if (nodplc[tabinf_1.irowno + loc - 1] - *i1 < 0) {
  133.     goto L30;
  134.     }
  135.  
  136. /*     find pointer to entry (i2,j) */
  137.  
  138. /*<    40 loc=j >*/
  139. L40:
  140.     loc = j;
  141. /*<    45 lsav2=loc >*/
  142. L45:
  143.     lsav2 = loc;
  144. /*<       loc=nodplc(irpt+loc) >*/
  145.     loc = nodplc[tabinf_1.irpt + loc - 1];
  146. /*<       if (loc.eq.0) go to 55 >*/
  147.     if (loc == 0) {
  148.     goto L55;
  149.     }
  150. /*<       if ((nodplc(irowno+loc)-i2).lt.0) go to 45 >*/
  151.     if (nodplc[tabinf_1.irowno + loc - 1] - *i2 < 0) {
  152.     goto L45;
  153.     }
  154.  
  155. /*     branch for col j in row i1, in both row i1 and i2, or in row i2 */
  156.  
  157. /*<    55 if (ktype) 60,70,75 >*/
  158. L55:
  159.     if (ktype < 0) {
  160.     goto L60;
  161.     } else if (ktype == 0) {
  162.     goto L70;
  163.     } else {
  164.     goto L75;
  165.     }
  166.  
  167. /*     entry (i1,j) */
  168.  
  169. /*<    60 if (lsav1.eq.lsav2) go to 65 >*/
  170. L60:
  171.     if (lsav1 == lsav2) {
  172.     goto L65;
  173.     }
  174. /*<       loc=nodplc(irpt+lsav2) >*/
  175.     loc = nodplc[tabinf_1.irpt + lsav2 - 1];
  176. /*<       nodplc(irpt+lsav2)=loc1 >*/
  177.     nodplc[tabinf_1.irpt + lsav2 - 1] = loc1;
  178. /*<       nodplc(irpt+lsav1)=nodplc(irpt+loc1) >*/
  179.     nodplc[tabinf_1.irpt + lsav1 - 1] = nodplc[tabinf_1.irpt + loc1 - 1];
  180. /*<       nodplc(irpt+loc1)=loc >*/
  181.     nodplc[tabinf_1.irpt + loc1 - 1] = loc;
  182. /*<    65 nodplc(irowno+loc1)=i2 >*/
  183. L65:
  184.     nodplc[tabinf_1.irowno + loc1 - 1] = *i2;
  185. /*<       loc1=nodplc(jcpt+loc1) >*/
  186.     loc1 = nodplc[tabinf_1.jcpt + loc1 - 1];
  187. /*<       go to 5 >*/
  188.     goto L5;
  189.  
  190. /*     entries (i1,j) and (i2,j) */
  191.  
  192. /*<    70 nodplc(irpt+lsav1)=loc2 >*/
  193. L70:
  194.     nodplc[tabinf_1.irpt + lsav1 - 1] = loc2;
  195. /*<       nodplc(irpt+lsav2)=loc1 >*/
  196.     nodplc[tabinf_1.irpt + lsav2 - 1] = loc1;
  197. /*<       loc=nodplc(irpt+loc1) >*/
  198.     loc = nodplc[tabinf_1.irpt + loc1 - 1];
  199. /*<       nodplc(irpt+loc1)=nodplc(irpt+loc2) >*/
  200.     nodplc[tabinf_1.irpt + loc1 - 1] = nodplc[tabinf_1.irpt + loc2 - 1];
  201. /*<       nodplc(irpt+loc2)=loc >*/
  202.     nodplc[tabinf_1.irpt + loc2 - 1] = loc;
  203. /*<       nodplc(irowno+loc1)=i2 >*/
  204.     nodplc[tabinf_1.irowno + loc1 - 1] = *i2;
  205. /*<       nodplc(irowno+loc2)=i1 >*/
  206.     nodplc[tabinf_1.irowno + loc2 - 1] = *i1;
  207. /*<       loc1=nodplc(jcpt+loc1) >*/
  208.     loc1 = nodplc[tabinf_1.jcpt + loc1 - 1];
  209. /*<       loc2=nodplc(jcpt+loc2) >*/
  210.     loc2 = nodplc[tabinf_1.jcpt + loc2 - 1];
  211. /*<       go to 5 >*/
  212.     goto L5;
  213.  
  214. /*     entry (i2,j) */
  215.  
  216. /*<    75 if (lsav1.eq.lsav2) go to 78 >*/
  217. L75:
  218.     if (lsav1 == lsav2) {
  219.     goto L78;
  220.     }
  221. /*<       loc=nodplc(irpt+lsav1) >*/
  222.     loc = nodplc[tabinf_1.irpt + lsav1 - 1];
  223. /*<       nodplc(irpt+lsav1)=loc2 >*/
  224.     nodplc[tabinf_1.irpt + lsav1 - 1] = loc2;
  225. /*<       nodplc(irpt+lsav2)=nodplc(irpt+loc2) >*/
  226.     nodplc[tabinf_1.irpt + lsav2 - 1] = nodplc[tabinf_1.irpt + loc2 - 1];
  227. /*<       nodplc(irpt+loc2)=loc >*/
  228.     nodplc[tabinf_1.irpt + loc2 - 1] = loc;
  229. /*<    78 nodplc(irowno+loc2)=i1 >*/
  230. L78:
  231.     nodplc[tabinf_1.irowno + loc2 - 1] = *i1;
  232. /*<       loc2=nodplc(jcpt+loc2) >*/
  233.     loc2 = nodplc[tabinf_1.jcpt + loc2 - 1];
  234. /*<       go to 5 >*/
  235.     goto L5;
  236.  
  237. /*     swap columns j1 and j2 */
  238.  
  239. /*<    80 loc1=nodplc(irpt+j1) >*/
  240. L80:
  241.     loc1 = nodplc[tabinf_1.irpt + *j1 - 1];
  242. /*<       loc2=nodplc(irpt+j2) >*/
  243.     loc2 = nodplc[tabinf_1.irpt + *j2 - 1];
  244. /*<       nodplc(irpt+j1)=loc2 >*/
  245.     nodplc[tabinf_1.irpt + *j1 - 1] = loc2;
  246. /*<       nodplc(irpt+j2)=loc1 >*/
  247.     nodplc[tabinf_1.irpt + *j2 - 1] = loc1;
  248.  
  249. /*     check for end of column */
  250.  
  251. /*<    85 if (loc1.le.0.and.loc2.le.0) go to 160 >*/
  252. L85:
  253.     if (loc1 <= 0 && loc2 <= 0) {
  254.     goto L160;
  255.     }
  256.  
  257. /*     check swap type */
  258.  
  259. /*<       if (loc1.eq.0) go to 100 >*/
  260.     if (loc1 == 0) {
  261.     goto L100;
  262.     }
  263. /*<       if (loc2.eq.0) go to 90 >*/
  264.     if (loc2 == 0) {
  265.     goto L90;
  266.     }
  267. /*<       if (nodplc(irowno+loc1)-nodplc(irowno+loc2)) 90,95,100 >*/
  268.     if ((i_1 = nodplc[tabinf_1.irowno + loc1 - 1] - nodplc[tabinf_1.irowno + 
  269.         loc2 - 1]) < 0) {
  270.     goto L90;
  271.     } else if (i_1 == 0) {
  272.     goto L95;
  273.     } else {
  274.     goto L100;
  275.     }
  276. /*<    90 ktype=-1 >*/
  277. L90:
  278.     ktype = -1;
  279. /*<       i=nodplc(irowno+loc1) >*/
  280.     i = nodplc[tabinf_1.irowno + loc1 - 1];
  281. /*<       go to 105 >*/
  282.     goto L105;
  283. /*<    95 ktype=0 >*/
  284. L95:
  285.     ktype = 0;
  286. /*<       i=nodplc(irowno+loc1) >*/
  287.     i = nodplc[tabinf_1.irowno + loc1 - 1];
  288. /*<       go to 105 >*/
  289.     goto L105;
  290. /*<   100 ktype=1 >*/
  291. L100:
  292.     ktype = 1;
  293. /*<       i=nodplc(irowno+loc2) >*/
  294.     i = nodplc[tabinf_1.irowno + loc2 - 1];
  295.  
  296. /*     find pointer to entry (i,j1) */
  297.  
  298. /*<   105 loc=i >*/
  299. L105:
  300.     loc = i;
  301. /*<   110 lsav1=loc >*/
  302. L110:
  303.     lsav1 = loc;
  304. /*<       loc=nodplc(jcpt+loc) >*/
  305.     loc = nodplc[tabinf_1.jcpt + loc - 1];
  306. /*<       if (loc.eq.0) go to 120 >*/
  307.     if (loc == 0) {
  308.     goto L120;
  309.     }
  310. /*<       if ((nodplc(jcolno+loc)-j1).lt.0) go to 110 >*/
  311.     if (nodplc[tabinf_1.jcolno + loc - 1] - *j1 < 0) {
  312.     goto L110;
  313.     }
  314.  
  315. /*     find pointer to entry (i,j2) */
  316.  
  317. /*<   120 loc=i >*/
  318. L120:
  319.     loc = i;
  320. /*<   125 lsav2=loc >*/
  321. L125:
  322.     lsav2 = loc;
  323. /*<       loc=nodplc(jcpt+loc) >*/
  324.     loc = nodplc[tabinf_1.jcpt + loc - 1];
  325. /*<       if(loc.eq.0) go to 135 >*/
  326.     if (loc == 0) {
  327.     goto L135;
  328.     }
  329. /*<       if ((nodplc(jcolno+loc)-j2).lt.0) go to 125 >*/
  330.     if (nodplc[tabinf_1.jcolno + loc - 1] - *j2 < 0) {
  331.     goto L125;
  332.     }
  333.  
  334. /*     branch for row i in col j1, in both col"s j1 and j2, or in col j2 
  335. */
  336.  
  337. /*<   135 if (ktype) 140,150,155 >*/
  338. L135:
  339.     if (ktype < 0) {
  340.     goto L140;
  341.     } else if (ktype == 0) {
  342.     goto L150;
  343.     } else {
  344.     goto L155;
  345.     }
  346.  
  347. /*     entry (i,j1) */
  348.  
  349. /*<   140 if (lsav1.eq.lsav2) go to 145 >*/
  350. L140:
  351.     if (lsav1 == lsav2) {
  352.     goto L145;
  353.     }
  354. /*<       loc=nodplc(jcpt+lsav2) >*/
  355.     loc = nodplc[tabinf_1.jcpt + lsav2 - 1];
  356. /*<       nodplc(jcpt+lsav2)=loc1 >*/
  357.     nodplc[tabinf_1.jcpt + lsav2 - 1] = loc1;
  358. /*<       nodplc(jcpt+lsav1)=nodplc(jcpt+loc1) >*/
  359.     nodplc[tabinf_1.jcpt + lsav1 - 1] = nodplc[tabinf_1.jcpt + loc1 - 1];
  360. /*<       nodplc(jcpt+loc1)=loc >*/
  361.     nodplc[tabinf_1.jcpt + loc1 - 1] = loc;
  362. /*<   145 nodplc(jcolno+loc1)=j2 >*/
  363. L145:
  364.     nodplc[tabinf_1.jcolno + loc1 - 1] = *j2;
  365. /*<       loc1=nodplc(irpt+loc1) >*/
  366.     loc1 = nodplc[tabinf_1.irpt + loc1 - 1];
  367. /*<       go to 85 >*/
  368.     goto L85;
  369.  
  370. /*     entries (i1,j) and (i2,j) */
  371.  
  372. /*<   150 nodplc(jcpt+lsav1)=loc2 >*/
  373. L150:
  374.     nodplc[tabinf_1.jcpt + lsav1 - 1] = loc2;
  375. /*<       nodplc(jcpt+lsav2)=loc1 >*/
  376.     nodplc[tabinf_1.jcpt + lsav2 - 1] = loc1;
  377. /*<       loc=nodplc(jcpt+loc1) >*/
  378.     loc = nodplc[tabinf_1.jcpt + loc1 - 1];
  379. /*<       nodplc(jcpt+loc1)=nodplc(jcpt+loc2) >*/
  380.     nodplc[tabinf_1.jcpt + loc1 - 1] = nodplc[tabinf_1.jcpt + loc2 - 1];
  381. /*<       nodplc(jcpt+loc2)=loc >*/
  382.     nodplc[tabinf_1.jcpt + loc2 - 1] = loc;
  383. /*<       nodplc(jcolno+loc1)=j2 >*/
  384.     nodplc[tabinf_1.jcolno + loc1 - 1] = *j2;
  385. /*<       nodplc(jcolno+loc2)=j1 >*/
  386.     nodplc[tabinf_1.jcolno + loc2 - 1] = *j1;
  387. /*<       loc1=nodplc(irpt+loc1) >*/
  388.     loc1 = nodplc[tabinf_1.irpt + loc1 - 1];
  389. /*<       loc2=nodplc(irpt+loc2) >*/
  390.     loc2 = nodplc[tabinf_1.irpt + loc2 - 1];
  391. /*<       go to 85 >*/
  392.     goto L85;
  393.  
  394. /*     entry (i,j2) */
  395.  
  396. /*<   155 if (lsav1.eq.lsav2) go to 158 >*/
  397. L155:
  398.     if (lsav1 == lsav2) {
  399.     goto L158;
  400.     }
  401. /*<       loc=nodplc(jcpt+lsav1) >*/
  402.     loc = nodplc[tabinf_1.jcpt + lsav1 - 1];
  403. /*<       nodplc(jcpt+lsav1)=loc2 >*/
  404.     nodplc[tabinf_1.jcpt + lsav1 - 1] = loc2;
  405. /*<       nodplc(jcpt+lsav2)=nodplc(jcpt+loc2) >*/
  406.     nodplc[tabinf_1.jcpt + lsav2 - 1] = nodplc[tabinf_1.jcpt + loc2 - 1];
  407. /*<       nodplc(jcpt+loc2)=loc >*/
  408.     nodplc[tabinf_1.jcpt + loc2 - 1] = loc;
  409. /*<   158 nodplc(jcolno+loc2)=j1 >*/
  410. L158:
  411.     nodplc[tabinf_1.jcolno + loc2 - 1] = *j1;
  412. /*<       loc2=nodplc(irpt+loc2) >*/
  413.     loc2 = nodplc[tabinf_1.irpt + loc2 - 1];
  414. /*<       go to 85 >*/
  415.     goto L85;
  416. /*<   160 return >*/
  417. L160:
  418.     return 0;
  419. /*<       end >*/
  420. } /* swapij_ */
  421.  
  422. #undef cvalue
  423. #undef nodplc
  424.  
  425.  
  426.